home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / game / patch / PFLaunch.lha / Pinball.e < prev    next >
Text File  |  1997-08-29  |  9KB  |  268 lines

  1. -> $VER: Pinball Fantasies AGA launcher source (28.8.97)
  2.  
  3. /*
  4. Sneaky space-saving constructs
  5.  
  6. I'm using two constants MEMSIZE and NVBLOCK, which are precalculated
  7. calculations with the constant HSLEN (they are HSLEN+10 and HSLEN/10+1,
  8. respectively)
  9.  
  10. Why generate code to manipulate constants?!
  11.  
  12. Uses '\s by Digital Illusions',[title] where title is 'Pinball Fantasies AGA'
  13. to save writing it twice!
  14.  
  15. Uses raw menupick values instead of pulling them out with (code generating)
  16. macros. But why are the values $FFFFxxxx ? Well, because msg.code is an INT,
  17. when I write code:=msg.code, E extracts the INT and sign-extends it to a
  18. LONG. As bit 15 is always set (NOSUBMENU), it's always considered negative.
  19. I could write code:=code AND $FFFF but that's more code for nothing! :)
  20. */
  21.  
  22.  
  23. OPT OSVERSION=39
  24.  
  25. MODULE    'exec/memory', 'exec/nodes', 'exec/ports',
  26.     'gadtools', 'libraries/gadtools',
  27.     'graphics/rastport', 'graphics/text',
  28.     'intuition/intuition', 'intuition/screens',
  29.     'lowlevel',
  30.     'nonvolatile',
  31.     'utility/tagitem'
  32.  
  33. CONST HSLEN=256,MEMSIZE=266,NVBLOCKS=26
  34.  
  35. OBJECT table
  36.   name, dir, file, hs_off
  37. ENDOBJECT
  38.  
  39. DEF wnd:PTR TO window, scr:PTR TO screen, tables:PTR TO table, title, hs
  40.  
  41. PROC main()
  42.   tables:=['Party Land',              'PF2:', 'pinfilea.dat', 0,
  43.            'Speed Devils',            'PF1:', 'pinfileb.dat', 48,
  44.            'Million Dollar Gameshow', 'PF3:', 'pinfilec.dat', 128,
  45.            'Stones ''n'' Bones',      'PF4:', 'pinfiled.dat', 176]:table
  46.  
  47.   title:='Pinball Fantasies AGA'
  48.  
  49.   SetChipRev(-1)
  50.  
  51.   IF gadtoolsbase:=OpenLibrary('gadtools.library',39)
  52.     IF nvbase:=OpenLibrary('nonvolatile.library',39)
  53.       IF lowlevelbase:=OpenLibrary('lowlevel.library',39)
  54.         IF hs:=AllocVec(MEMSIZE,MEMF_CLEAR)
  55.           IF scr:=LockPubScreen(NIL)
  56.             createwindow()
  57.             UnlockPubScreen(NIL,scr)
  58.           ENDIF
  59.           FreeVec(hs)
  60.         ENDIF
  61.         CloseLibrary(lowlevelbase)
  62.       ENDIF
  63.       CloseLibrary(nvbase)
  64.     ENDIF
  65.     CloseLibrary(gadtoolsbase)
  66.   ENDIF
  67. ENDPROC
  68.  
  69. PROC createwindow()
  70.   DEF font:PTR TO textfont, gad:PTR TO gadget, rp:PTR TO rastport,
  71.       gadlist, visinf, menus, n,
  72.       gad_w, gad_h, off_x, off_y, wnd_w, wnd_h
  73.  
  74.   -> font sensitive gadget layout calculations
  75.   rp:=scr.rastport
  76.   font:=rp.font
  77.   off_x:=scr.wborleft              -> left border offset
  78.   off_y:=rp.txheight+scr.wbortop+1 -> top border offset
  79.  
  80.   -> calculate generic gadget width from the longest of the buttons
  81.   gad_w:=0
  82.   FOR n:=0 TO 3 DO gad_w:=Max(gad_w,TextLength(rp,tables[n].name,StrLen(tables[n].name))+32)
  83.   gad_h:=font.ysize+6
  84.  
  85.   -> window width and height
  86.   wnd_w:=Max(off_x + gad_w + 4 + scr.wborright,
  87.              off_y*2 + TextLength(rp,title,StrLen(title)))
  88.   wnd_h:=gad_h+1*4+off_y+1+scr.wborbottom
  89.  
  90.   IF visinf:=GetVisualInfoA(scr,[TAG_DONE])
  91.     IF gad:=CreateContext({gadlist})
  92.       FOR n:=0 TO 3
  93.         gad:=CreateGadgetA(BUTTON_KIND,gad,
  94.              [off_x+2,           -> left edge
  95.               gad_h+1*n+off_y+1, -> top edge
  96.               gad_w, gad_h,      -> width, height
  97.               tables[n].name,    -> name
  98.               [font.mn.ln.name,font.ysize,0,0]:textattr, -> font
  99.               n,                 -> gadgetID
  100.               16,visinf,0]:newgadget,NIL)
  101.       ENDFOR
  102.       IF menus:=CreateMenusA(
  103.                 [NM_TITLE, 0,'Project',   NIL, 0,0,0,
  104.                  NM_ITEM,  0,'About...', '?',  0,0,0,
  105.                  NM_ITEM,  0,NM_BARLABEL, NIL, 0,0,0,
  106.                  NM_ITEM,  0,'Quit',      'Q', 0,0,0,
  107.                  NM_END,   0,NIL,         NIL, 0,0,0]:newmenu,0)
  108.         IF LayoutMenusA(menus,visinf,[GTMN_NEWLOOKMENUS,TRUE,TAG_DONE])
  109.           IF wnd:=OpenWindowTagList(NIL,
  110.                   [WA_LEFT,   (scr.width-wnd_w)/2,
  111.                    WA_TOP,    (scr.height-wnd_h)/2,
  112.                    WA_WIDTH,  wnd_w,
  113.                    WA_HEIGHT, wnd_h,
  114.                    WA_IDCMP,  IDCMP_REFRESHWINDOW OR
  115.                               IDCMP_VANILLAKEY OR
  116.                               IDCMP_GADGETUP OR
  117.                               IDCMP_CLOSEWINDOW OR
  118.                               IDCMP_MENUPICK,
  119.                    WA_FLAGS,  WFLG_ACTIVATE OR
  120.                               WFLG_DRAGBAR OR
  121.                               WFLG_CLOSEGADGET OR
  122.                               WFLG_DEPTHGADGET OR
  123.                               WFLG_NEWLOOKMENUS,
  124.                    WA_TITLE, title,
  125.                    WA_GADGETS, gadlist,
  126.                    WA_PUBSCREEN, scr,
  127.                    WA_SCREENTITLE, 'PFLaunch by Kyzer/CSG <kyzer@4u.net>',
  128.                    WA_AUTOADJUST, TRUE,
  129.                    TAG_DONE])
  130.             IF SetMenuStrip(wnd,menus)
  131.               Gt_RefreshWindow(wnd,NIL)
  132.               handlewindow()
  133.               ClearMenuStrip(wnd)
  134.             ENDIF
  135.             CloseWindow(wnd)
  136.           ENDIF
  137.         ENDIF
  138.         FreeMenus(menus)
  139.       ENDIF
  140.       FreeGadgets(gadlist)
  141.     ENDIF
  142.     FreeVisualInfo(visinf)
  143.   ENDIF
  144. ENDPROC
  145.  
  146. PROC handlewindow()
  147.   DEF iaddr:PTR TO gadget, msg:PTR TO intuimessage, code, class, quitflag=0
  148.   REPEAT
  149.     WaitPort(wnd.userport) -> might as well wait for a message first
  150.     WHILE msg:=Gt_GetIMsg(wnd.userport)
  151.       class:=msg.class   -> copy info from msg then reply it immediately
  152.       code:=msg.code
  153.       iaddr:=msg.iaddress
  154.       Gt_ReplyIMsg(msg)
  155.  
  156.       SELECT class
  157.       CASE IDCMP_REFRESHWINDOW  -> refresh window
  158.         Gt_BeginRefresh(wnd)
  159.         Gt_EndRefresh(wnd,TRUE)
  160.  
  161.       CASE IDCMP_CLOSEWINDOW    -> closegadget pressed
  162.         quitflag:=TRUE
  163.  
  164.       CASE IDCMP_VANILLAKEY     -> key pressed, code=key
  165.         IF (code>="1") AND (code<="4") THEN play(code-"1")
  166.         IF (code="Q") OR (code="q") OR (code="\e") THEN quitflag:=TRUE
  167.  
  168.       CASE IDCMP_GADGETUP       -> gadget pressed then released
  169.         play(iaddr.gadgetid)
  170.  
  171.       CASE IDCMP_MENUPICK       -> menu item chosen
  172.         SELECT code
  173.         CASE $FFFFF800   -> 'About...'
  174.           request('\s by Digital Illusions.\n\n'+
  175.                   'Published by 21st Century Entertainment.',0,[title])
  176.         CASE $FFFFF840   -> 'Quit'
  177.           quitflag:=TRUE
  178.         ENDSELECT
  179.       ENDSELECT
  180.     ENDWHILE
  181.   UNTIL quitflag
  182. ENDPROC
  183.  
  184.  
  185. PROC play(lev)
  186.   DEF lock, loadseg, nv, olddir, req:requester, gamedata:PTR TO LONG
  187.  
  188.   IF nv:=GetCopyNV('Pinball','Highscore',TRUE)
  189.     CopyMem(nv,hs,HSLEN)
  190.     FreeNVData(nv)
  191.   ELSE
  192.     CopyMem({defsc},hs,HSLEN)
  193.   ENDIF
  194.  
  195.   InitRequester(req); Request(req,wnd)
  196.   SetWindowPointerA(wnd,[WA_BUSYPOINTER,TRUE,TAG_DONE])
  197.  
  198.   IF (loadseg:=LoadSeg(tables[lev].file))=0
  199.     IF lock:=Lock(tables[lev].dir,-2)
  200.       olddir:=CurrentDir(lock)
  201.       loadseg:=LoadSeg(tables[lev].file)
  202.       CurrentDir(olddir)
  203.       UnLock(lock)
  204.     ENDIF
  205.   ENDIF
  206.  
  207.   ClearPointer(wnd); EndRequest(req,wnd)
  208.  
  209.   IF loadseg=0
  210.     request('Can''t load table',0)
  211.     RETURN
  212.   ENDIF
  213.   Delay(50)
  214.   CacheClearU()
  215.  
  216.   -> this is the data that the game code wants
  217.   gamedata:=[0,hs+tables[lev].hs_off,hs,dosbase,gfxbase,nvbase,lowlevelbase,
  218.              0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
  219.  
  220.     MOVEM.L    D1-D7/A0-A6,-(A7)
  221.     MOVE.L    gamedata,A1
  222.     MOVE.L    loadseg,A0 -> loadseg is a BPTR
  223.     ADDA.L    A0,A0
  224.     ADDA.L    A0,A0
  225.     MOVE.L    A1,A5 -> this is OK, even though E warns you about it!
  226.     SUBA.L    A1,A1
  227.     JSR    4(A0)
  228.     MOVEM.L    (A7)+,D1-D7/A0-A6
  229.     TST.L    D0
  230.     BEQ    noscores
  231.  
  232.   REPEAT
  233.     IF StoreNV('Pinball','Highscore',hs,NVBLOCKS,FALSE)=0 THEN JUMP noscores
  234.   UNTIL request('Can''t save highscores','Retry|Cancel')=0
  235. noscores:
  236.   UnLoadSeg(loadseg)
  237. ENDPROC
  238.  
  239. PROC request(b,r,a=0)
  240. ENDPROC EasyRequestArgs(wnd,[20,0,title,b,IF r THEN r ELSE 'OK'],0,a)
  241.  
  242.  
  243. -> The default scores
  244. defsc:
  245.   LONG    "TSL ",0,$50000000, ->  50,000,000 points (Party Land)
  246.     "TSL ",0,$25000000, ->  25,000,000 points (Party Land)
  247.     "TSL ",0,$10000000, ->  10,000,000 points (Party Land)
  248.     "TSL ",0,$05000000, ->   5,000,000 points (Party Land)
  249.     "TSL ",1,$00000000, -> 100,000,000 points (Speed Devils)
  250.         "TSL ",0,$50000000, ->  50,000,000 points (Speed Devils)
  251.         "TSL ",0,$25000000, ->  25,000,000 points (Speed Devils)
  252.         "TSL ",0,$10000000, ->  10,000,000 points (Speed Devils)
  253.         "   P","ARTY"," LAN","D   ",
  254.     "  SP","EED ","DEVI","LS  ",
  255.         "TSL ",1,$00000000, -> 100,000,000 points (Billion $ Gameshow)
  256.         "TSL ",0,$50000000, ->  50,000,000 points (Billion $ Gameshow)
  257.         "TSL ",0,$25000000, ->  25,000,000 points (Billion $ Gameshow)
  258.         "TSL ",0,$10000000, ->  10,000,000 points (Billion $ Gameshow)
  259.         "TSL ",1,$00000000, -> 100,000,000 points (Stones 'n' Bones)
  260.         "TSL ",0,$50000000, ->  50,000,000 points (Stones 'n' Bones)
  261.         "TSL ",0,$25000000, ->  25,000,000 points (Stones 'n' Bones)
  262.         "TSL ",0,$10000000, ->  10,000,000 points (Stones 'n' Bones)
  263.     " BIL","LION"," DOL","LAR ",
  264.     " STO","NES ","N BO","NES "
  265.  
  266. CHAR '\0$VER: PFLaunch 1.1 (28.8.97)\0'
  267.  
  268.